00100	C ********** EARLY MUSIC NOTATION PACKAGE ************
00200	C TO CHANGE CONVENTIONAL NOTATION ENTERED WITH '14' OR '144' TO EARLY MUSIC
00300	C NOTATION, ADD 500 TO P4 OF ALL NOTES AND RESTS. (USE 'A' COMMAND.)
00400	C THE VARIOUS NOTE SHAPES ARE DETERMINED BY THE RHYTHMIC VALUE FOUND IN P9
00500	C (OR P7 WITH RESTS).  THE SAME SHAPES CAN BE MADE BY PUTTING VALUES IN P6 IF
00600	C P9=0.  THE FOLLOWING TABLE SHOWS NUMBERS FOR BOTH METHODS.  THE RHYTHMIC
00700	C VALUE (P9 OR P7) COMES BEFORE THE SHAPE NAME.  THE P6 VALUES FOLLOW EACH NAME.
00800	C THE STANDARD NOTE VALUES WOULD BE: DOUBLE WHOLE, WHOLE, 1/2, 1/4, 1/8, 1/16.
00900	C  8 = MAXIMA = 20;      4 = LONGA = 21;   2 = BREVIS = 22;
01000	C  1 = SEMIBREVE = 23;  .5 = MINIM = 24;  .25 = SEMIMINIM = 25;
01100	
01200	C  SET 'COLORATION' IN P8 IF NOT SET BY RHYTH.(P9)  -1=BLACK, 0=WHITE HERE.
01300	
01400	C MENSURATION SIGNS ARE CONSIDERED TO BE A FORM OF 'NOTE'.  THE VERTICAL
01500	C POSITION IS SET IN P4 WITH THE 'ZERO' LEVEL BEING IN THE SECOND SPACE FROM
01600	C THE BOTTOM OF THE STAFF. (POSITION OF NOTE 'A'.)
01700	C SET P9 TO 0 AND P6 AS FOLLOWS.
01800	C MENSURATION SIGNS: P6 =30=C; 31=C WITH DOT IN MIDDLE; 32=C WITH SLASH; 
01900	C  			33=O; 34=O WITH SLASH.
02000	
02100	C  LIGATURES ARE CREATED FROM COMBINATIONS OF MAXIMA, LONGA AND BREVIS SHAPES
02200	C  OR, FOR THE SLOPED SHAPES, BY SETTING P9=0 AND P6 EQUAL TO SOME NUMBER FROM
02300	C  11 TO 19.  FOR SLOPES IT IS THE SECOND DIGIT OF THE NUMBER THAT DETERMINES
02400	C  THE GOAL OF THE SLOPE.  IF THE NUMBER IS NEGATIVE THE SLOPE WILL BE DOWNWARD.
02500	C    P4=504  P6=11 WILL MAKE A SLOPE FROM F (TREBLE CLEF) UP TO G.
02600	C    IF P6=14 THE SLOPE WILL BE FROM F UP TO C.  P4=508  P6=-14 WILL GIVE A
02700	C    SLOPE DOWN FROM C TO F.
02800	
02900	C TO MOVE ANY SLOPING LIGATURE EXACTLY ITS OWN WIDTH TO THE LEFT (FOR COMB-
03000	C INED LIGATURES) SET P9 TO -1.  P3 WILL THEN INDICATED THE POSITION OF ITS
03100	C RIGHT SIDE INSTEAD OF ITS LEFT SIDE.
03200	
03300	C  FOR THE COMBINATION LIGATURES, FIRST SET P9 TO 0. NEXT THE RIGHT HAND
03400	C SQUARE WILL BE SET.  P6=22 GIVES A SIMPLE SQUARE WITH NO STEM.(BREVIS)
03500	C FOR A DESCENDING STEM ON THE RIGHT SIDE, P6=21.(LONGA)
03600	C FOR AN ASCENDING STEM ON THE RIGHT SIDE, P6=29.
03700	C FOR A STEM ON THE LEFT SIDE OF THE SQUARE SET P7 TO A NEGATIVE NUMBER.
03800	C THE ABSOLUTE VALUE OF THIS NUMBER WILL DETERMINE THE LENGTH OF THE STEM.
03900	C THE DIRECTION OF THIS LEFT STEM IS SET IN P5. UP, P5=10; DOWN, P5=20.
04000	
04100	C THE LEFT HAND SQUARE IS IS BEST ENTERED BY MAKING A COPY OF THE RIGHT ONE.
04200	C WITH THE COPY, WHEN P5 IS SET TO -1 THE SQUARE PIVOTS ON ITS LEFT SIDE.
04300	C THIS NEW NOTE MAY BE MOVED UP OR DOWN TO THE PROPER POSITION.  AS A
04400	C RESULT OF THIS PIVOTING A STEM THAT WAS ORIGINALLY ON THE RIGHT SIDE NOW
04500	C APPEARS ON THE LEFT SIDE.(STEM UP, P6=21; DOWN, P6=29)  NO STEM CAN BE
04600	C PUT ON THE RIGHT SIDE OF A REVERSED NOTE.  ANY STEM NEEDED IN THE CENTRAL
04700	C POSITION, BETWEEN THE TWO SQUARES, CAN BE ADDED TO THE RIGHT HAND NOTE BY
04800	C PUTTING THE PROPER VALUES IN P7 (NEGATIVE) AND P5 (10=↑, 20=↓).  BY
04900	C CHANGING THE VALUES OF P7 THIS CENTRAL STEM MAY BE USED TO CONNECT THE
05000	C TWO NOTES TOGETHER AS WELL AS TO EXTEND BEYOND THE LEFT HAND NOTE.
05100	C BY USING THIS PIVOTING METHOD BOTH HALVES OF A TWO NOTE LIGATURE WILL
05200	C WILL HAVE THE SAME HORIZANTAL POSITION IN P3, WHICH WILL INDICATE THE
05300	C CENTER OF THE LIGATURE.
05400	
05500		SUBROUTINE EXTRA 
05600		IMPLICIT INTEGER(A-Q,S-Z)
05700		REAL POS
05800		COMMON /STF/RSTFAC(-3/4),RSTJ2
05900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
06000		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
06100		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RB,RZ,RJY,
06200		1 QQ,RJW,ZZ,JX,RG,KL,RJAC,K,L,RQ,RXO,J5X,RNO,JJJ,
06300		1 PUNCT,RDIS,RJ
06400		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(NJR,RJQ(8)),
06500		1 (J6,JQ(4)),(R8,RJQ(6)),(R7,RJQ(5)),(R9,RJQ(7)),(J9,JQ(7))
06600		1,(J4,JQ(2)),(R3,RJQ(1)),(J10,JQ(8)),(R11,RJQ(9)),(J8,JQ(6))
06700		1,(J7,JQ(5)),(RX3,RJQ(20)),(R5,RJQ(3)),(RH,RJQ(19)),(RXX,RJQ(18))
06750		1,(J3,JQ(1))
06800		DATA RBIG/1.5/,RLIG/2.0/
06900	
07000		IF(JA.EQ.2)R9=R7
07100		KL=IABS(J6)
07200		IF(KL.GT.5)GO TO 10
07300		IF(R9.NE.0)GO TO 2
07400	10	IF(JA.EQ.1)J5=J6
07500		IF(KL.GE.30)GO TO 30
07600	C  JUMP FOR MENSURATION SIGNS.
07700	C  PUT NUM. IN P6 IF P9 NOT USED. 20=MAXIMA, 21=LONGA, 22=BREVIS, ETC.
07800		IF(R8.GE.0)R8=-2
07900	C  MAKES IT WHITE UNLESS -1 IS IN R8
08000		GO TO 3
08100	2	RH=.75
08200		DO 21 K=1,5
08300		IF(R9.NE.RH)GO TO 21
08400		R9=R9*2
08500		R9=R9/3.
08600		GO TO 22
08700	21	RH=RH*2.
08800	22	RA=AMOD(R9,.25)
08900	C  RA=0=WHITE,  ≠0='COLORATION'
09000		IF(RA.NE.0)R9=R9*1.5
09100	C  TO GET THE RIGHT SHAPE
09200		J5=19.5+ALOG(16./R9)/.693147181
09300	C  I.E. /ALOG(2.)  FINDS SEQ. NUM IN DRAW FILE 'EARLY'. 20=MAXIMA, ETC.
09400		R8=-1
09500	C  FILL IT ALWAYS (BLACK NOTE)
09600		IF(RA.EQ.0)R8=-2
09700	C  ALWAYS WHITE
09800	3	IF(JA.EQ.2)GO TO 20
09900		RH=R5
10000		JA=3 
10100		K=J4
10200		RXX=POS-18.*RSTJ2
10300		IF(J5.LT.20)GO TO 6
10400	C GO MAKE 'LIGATURES' P6=11=1 UP, =-11=1 DOWN, 12=2 UP, ETC.
10500		R6=RBIG
10600		NJR='CLEF2'
10700	C  ↑↑↑ EQUIV. TO R10
10800		R7=RBIG
10900		IF(R5)R6=-R6
11000	C  IF P5 IS NEG THEN ITEM MOVES TO LEFT EXACTLY ITS SPACE.
11100		J9=0
11200		IF(J5.NE.25)GO TO 17
11300		IF(R8.NE.-1)J5=29
11400		R8=-1
11500	COLORED SEMIMINIM=25, WHITE=29
11600		GO TO 7
11700	17	IF(J5.NE.29)GO TO 7
11800		R7=-R7
11900		R4=R4-5.8
12000	C  MAKES LONGA WITH STEM UP -- FOR LIGATURES
12100		J5=21
12200	7	CALL CLEFS
12300		IF(J7.GE.0)GO TO 1
12400	C IF P7 IS NEG THERE WILL BE A STEM ON LFT SIDE =ABS(R7), P5 HAS UP-DN.
12500		RG=R4
12600		R5=-J7*RST7
12700		GO TO 14
12800	6	RG=R4
12900	C THIS WILL BE FOR LIGATURE STEMS (P5=10=UP, =20=DOWN)
13000		IF(KL.GT.10)GO TO 11
13100		R6=-R6*10.
13200		GO TO 12
13300	11	R6=KL-10
13400		IF(J6)R6=-R6
13600	12	RX7=-.1
13700		IF(R6)RX7=-RX7
13800		R4=R4+RX7
13900		R6=R6-RX7*2.
14000	C  ABOVE TO ADJUST END POINTS OF TILTS.
14100		RX7=R7
14200		IF(J9)R3=R3-27.*RSTJ2
14300	C  J7=-1= SHIFT IT TO LEFT IT'S WIDTH.
14400		RA=R3
14500		IF(J8)GO TO 9
14600		RJW=POS
14700	5	R4=R4-.45
14800		J5=50
14900	C  P8<0=BLACK LIG.   ≥0=WHITE LIG.
15000		J10=0
15100	 	RXO=RLIG
15200		R8=3.9
15300		R11=R6
15400		R3=R3+13.85*RSTJ2
15500		RB=R3
15700		DO 55 JJJ=1,7 
15800		R9=RXO
15900		CALL ITMSUB
16000		POS=RJW
16100		R8=3.8
16200		R3=RB
16300	55	RXO=RXO-.144
16400	C  THICKENS HORIZ. SIDES
16500		R9=RXO
16600		GO TO 8
16700	9	R4=R4-.95
16750		J9=0
16800		R5=R4+R6/RSTJ2
16900	CC	R9=200
17000		J7=1
17100		R8=4.6
17200		R6=RX3+R8
17300		J10=14
17400	C  MAKES SLOPED DASH, 14XTHICK
17410		IF(J9.EQ.0)GO TO 8
17420		R6=RX3
17430		J3=R3
17500	8	CALL ITMSUB
17600		IF(RH.EQ.0)GO TO 13
17700		R5=ABS(RX7)
17800		IF(R5.EQ.0)R5=5
17900		R5=R5*RST7
18000	14	RG=RG*RST7+RXX
18100		IF(RH.GE.20)R5=-R5
18200	C NOW STEM IS DOWN. (-R5)
18300		CALL LINX(R3,RG,R3,RG+R5)
18400	13	R4=RG
18500		J5=20
18600		R3=RA
18700	
18800	1	IF(K.LT.502)GO TO 4
18900		IF(K.LT.513)RETURN
19000	C  WILL NOW DO 1 LEDG. LINE ABOVE OR BELOW.
19100	4	R4=RST7
19200		IF(K.GT.502)R4=13.*RST7
19300		R4=R4+RXX
19400		R5=20.
19500		IF(J5.EQ.20)R5=34.
19600		CALL LINX(R3-RST7,R4,R3+R5*RSTJ2,R4)
19700	
19800		RETURN
19900	
20000	20	IF(R9.NE.0)J5=R5+23.
20100		RG=POS
20200	C SAVE IT FOR SEMIMINIM REST HORIZANTAL
20300	C  RESTS ARE SET BY RHYTHM(R9,7) OR IN J5 (20-25)
20400		R5=(J5-20)*2+3
20500		RA=R4
20600		IF(R5.GT.8.)R5=8.
20700		R5=R4+R5
20800	C  RESTS (500+ IN P4) CAN BE MOVED UP OR DOWN
20900		R4=9
21000		IF(J5.GT.23)R4=7.
21100		R4=R4+RA
21200		J10=3
21300		J7=0
21400		R6=RX3
21500	C ALL THIS MAKES VERT. LINE.
21600		CALL ITMSUB
21700		IF(J5.LT.25)RETURN
21800	C NEXT IS FOR SEMIMINIM REST (1/16)
21900		R6=RX3+1.3
22000		R4=8+RA
22100		R5=R4
22200		POS=RG
22300		CALL ITMSUB
22400	 	RETURN
22500	
22600	C  MENSURATION SIGNS. USES P6 AS A NOTE. =30=C; 31=C.; 32=C/; 33=O; 34=O/
22700	30	JA=12
22800		R4=R4+6
22900		CALL CENTX
23000	C  P4=500 PUTS IT AT POS 6.
23100		R5=1
23200		J8=1
23300		IF(J5.GT.32)GO TO 31
23400	C  NEXT ARE C'S
23500		J6=125
23600		J7=45
23700		GO TO 32
23800	31	J6=0
23900		J7=0
24000	32	CALL SLUR
24100		IF(J5.NE.31)GO TO 33
24200	C  NEXT IS C.
24300		J5=0
24400		J6=0
24500		J7=0
24600		R5=.1
24700		GO TO 31
24800	33	IF(J5.LT.32)RETURN
24900		IF(J5.EQ.33)RETURN
25000		R5=R4+1
25100		R4=R4-1
25200		R3=R3-11.*RSTJ2
25300		J7=0
25400		R6=RX3+2*RSTJ2
25500		CALL ITMSUB
25600		END